home *** CD-ROM | disk | FTP | other *** search
/ Amiga Plus Leser 15 / Amiga Plus Leser CD 15.iso / Tools / Development / yacas_alg / yacas_morphos / share / yacas / addons / unix.ys < prev   
Encoding:
Text File  |  2002-03-13  |  4.7 KB  |  118 lines

  1. /*
  2.     MakeFunctionPlugin() - create an external plugin for a numerical function
  3.     Version 0.1
  4.     Requires: compiler named "c++" with ELF .so support; Yacas headers in FindFile("")/include; current directory must be writable
  5.     Usage: MakeFunctionPlugin(ExtName, ArgList, Body)
  6. */
  7.  
  8. MakeArgumentList(argList, padding) := [ /* may assume to have a nonempty list */
  9.     Local(item, result);
  10.     /* build a list and add commas after 1st element */
  11.     result := padding : String(Head(argList));
  12.     ForEach(item, Tail(argList))
  13.       result := result : "," : padding : String(item);
  14.     result;
  15. ];
  16.  
  17. MakeFunctionPrototype(name, argList) := [
  18.     "double " : name : "(" : MakeArgumentList(argList, "double ") : ")";
  19. ];
  20.  
  21. MakeFunctionPlugin(extName, fBody) := [
  22.     Local(dirBase, fileBase, intName, exportName, includeDir, dllName, dllPath, commandLine, argList);
  23.     /* check argument type */
  24.     argList := VarList(fBody);
  25.     Check(IsString(extName) And Length(argList) > 0,
  26.       "Error in MakeFunctionPlugin: " : extName
  27.       : " must be a string and " : argList : " a nonempty list.");
  28.     includeDir := FindFile("include/");
  29.     Check(includeDir != "",
  30.       "Error in MakeFunctionPlugin: no include/ under " : FindFile(""));
  31.     /* determine file names */
  32.     dirBase := "plugins.tmp/";    // where all plugin files will be kept
  33.     SystemCall("test -d " : dirBase : "|| mkdir -p " : dirBase);
  34.     fileBase := dirBase : extName : "_plugin";
  35.     intName := extName : "_plugin_cc";    // name of C++ function
  36.     exportName := extName : "_plugin"; // name of intermediate Yacas function
  37.     dllName := "lib" : intName : ".so";
  38.     dllPath := dirBase : dllName;
  39.     /* specify more include dirs to be able to compile from different places */
  40.     commandLine := "c++ -shared -I. -I.. -I" : includeDir : " -I" : includeDir : "plat/linux32 -Wl,-soname," : dllName : " -o " : dllPath : " " : fileBase : ".cc " : fileBase : "_api.cc >& " : fileBase : ".log";
  41.     /* write C++ header */
  42.     ToFile(fileBase : ".h")
  43.       WriteString(
  44.         "// GENERATED FILE: " : fileBase : ".h" : Nl()
  45.         : MakeFunctionPrototype(intName, argList) : ";" : Nl()
  46.       );
  47.     /* write C++ body */
  48.     ToFile(fileBase : ".cc")
  49.       WriteString(
  50.         "// GENERATED FILE: " : fileBase : ".cc" : Nl()
  51.         : "#include \"stubs.h\"" : Nl()
  52.         : "#include \"" : fileBase : ".h\"": Nl()
  53.         : "#include <math.h>" : Nl()
  54.         : "const double Pi=" : CForm(Hold(4.*ArcTan(1.))): ";" : Nl()
  55.         : MakeFunctionPrototype(intName, argList) : " {" : Nl()
  56.         : "return " : CForm(fBody) : ";" : Nl()
  57.         : "}" : Nl()
  58.       );
  59.     /* write Yacas stub */
  60.     ToFile(fileBase : ".stub") [
  61.       WriteString(
  62.         "/* GENERATED FILE: " : fileBase : ".stub */" : Nl()
  63.         : "Use(\"cstubgen.rep/code.ys\"); StubApiCStart();" : Nl()
  64.         : "StubApiCInclude(\"\\\"" : fileBase : ".h\\\"\");" : Nl()
  65.         : "StubApiCFunction(\"double\", \"" : intName : "\", \"" : exportName : "\",");
  66.       Write(FillList("double", Length(argList)));
  67.       WriteString(
  68.         ");" : Nl()
  69.         : "StubApiCFile(\"" : fileBase : "_api\");" : Nl()
  70.       );
  71.     ];
  72.     /* generate C++ stub */
  73.     Load(fileBase : ".stub");
  74.     /* compile plugin for Linux */
  75.     ToFile(fileBase : ".compile") WriteString(commandLine : Nl());
  76.     /* delete old file */
  77.     SystemCall("rm -f " : dllPath);
  78.     SystemCall(commandLine);
  79.     /* If compilation succeeds, DLL file is present */
  80.     Check(FindFile(dllPath) = dllPath, "Error in MakeFunctionPlugin: compilation of " : fileBase : ".so failed.");
  81.     /* Load DLL file */
  82.     DllUnload(dllPath);
  83.     DllLoad(dllPath);
  84.     Echo({"Function " : extName : "(" : MakeArgumentList(argList, ""): ") loaded from " : dllPath});
  85.     /* define wrapper */
  86.     NFunction(extName, exportName, argList);
  87. ];
  88.  
  89. /* Example code to read the PID of the Yacas process into the variable PID
  90.     We have to jump through the hoops here because we can't redirect STDOUT to a Yacas stream... ideally it would be just this:
  91.     PID := FromString(ToString() SystemCall("echo $PPID ';'")) Read();
  92. */
  93. GetYacasPID() := [
  94.     SystemCall("echo $PPID ';' > /tmp/yacas-tmp");
  95.     FromFile("/tmp/yacas-tmp") Read();
  96. ];
  97.  
  98. /* show a Yacas expression graphically in a PS file */
  99. /* The following global variable will define the available PS viewer */
  100. If(Not(IsBound(PSViewCommand)), PSViewCommand := "gv");
  101.  
  102. ShowPS(expr) := [
  103.     /* Create a temporary file */
  104.     SystemCall("echo \\\"/tmp/yacas-tmpfile-$$\\\" ';' > /tmp/yacas-tmp");
  105.     filename := FromFile("/tmp/yacas-tmp") Read();
  106.     SystemCall("rm -f /tmp/yacas-tmp");
  107.     ToFile(filename : ".tex") WriteString(
  108. "\\documentclass{article} \\begin{document} \\thispagestyle{empty}
  109. " : TeXForm(expr) : "
  110. \\end{document}
  111. ");
  112.     WriteString("Expression exported as " : filename : ".tex" : Nl());
  113.     /* Make PS file */
  114.     SystemCall("cd /tmp; latex " : filename : " > /dev/null; dvips -q -o " : filename : ".ps " : filename : ".dvi");
  115.     /* Show PS file */
  116.     SystemCall(PSViewCommand : " " : filename : ".ps; rm -f " : filename : ".*");
  117. ];
  118.